﻿
Public MustInherit Class poolbase(Of T, _THREADSAFE As _boolean, _RNDSELECT As _boolean, _ENABLEAPPEND As _boolean)
    Public Const invalidIndex As Int64 = npos
    Private Shared _tf As Boolean = False
    Private Shared _rnd As Boolean = False
    Private Shared _ea As Boolean = False
    Private _lock As lock(Of locks.monitorlock)

    Shared Sub New()
        _tf = +(alloc(Of _THREADSAFE)())
        _rnd = +(alloc(Of _RNDSELECT)())
        _ea = +(alloc(Of _ENABLEAPPEND)())
    End Sub

    Protected Overridable Function create() As T
        Return alloc(Of T)()
    End Function

    Private Shared Function randomselect() As Boolean
        Return _rnd
    End Function

    Private Shared Function threadsafe() As Boolean
        Return _tf
    End Function

    Private Shared Function enableAppend() As Boolean
        Return _ea
    End Function

#If Not PocketPC AndAlso Not Smartphone Then
    <ThreadStatic()> Private Shared index As Int64? = Nothing

    Public Function currentInstance() As T
        Return at(index)
    End Function

    Public Function currentIndex() As Int64
        assert(index.Value() <> invalidIndex, "has not set index in current thread.")
        Return index
    End Function

    Public Function getfree() As Boolean
        Return getfree(Nothing)
    End Function

    Public Function getfree(ByRef inst As T) As Boolean
        If Not index.HasValue Then
            index = invalidIndex
        End If
        assert(index.Value() = invalidIndex, "index is already set to ", index)
        Return getfree(index, inst)
    End Function

    Public Function release() As Boolean
        Return release(currentIndex()) AndAlso eva(index, invalidIndex)
    End Function
#End If

    Protected MustOverride Property at(ByVal index As Int64) As T
    Protected MustOverride Property free(ByVal index As Int64) As Boolean
    Protected MustOverride Function size() As Int64

    Protected Overridable Function append() As Int64
        Return invalidIndex
    End Function

    Private Sub lock()
        If threadsafe() Then
            _lock.wait()
        End If
    End Sub

    Private Sub unlock()
        If threadsafe() Then
            _lock.release()
        End If
    End Sub

    Public Function getfree(ByRef i As Int64, ByRef inst As T) As Boolean
        lock()
        If randomselect() Then
            Dim start As Int64
            start = rnd(0, size(), True)
            i = start
            Do
                If free(i) Then
                    Exit Do
                End If
                i += 1
                If i = size() Then
                    i = 0
                End If
            Loop Until i = start
            If i = start Then
                i = size()
            End If
        Else
            For i = 0 To size() - 1
                If free(i) Then
                    Exit For
                End If
            Next
        End If

        If Not validIndex(i) AndAlso enableAppend() Then
            i = append()
        End If

        Dim rtn As Boolean = False
        If validIndex(i) Then
            If at(i) Is Nothing Then
                at(i) = create()
            End If
            inst = at(i)
            free(i) = False
            rtn = True
        Else
            rtn = False
        End If

        unlock()
        Return rtn
    End Function

    Public Function validIndex(ByVal index As Int64) As Boolean
        Return index < size() AndAlso index >= 0
    End Function

    Public Function release(ByVal i As Int64) As Boolean
        If validIndex(i) Then
            free(i) = True
            Return True
        Else
            Return False
        End If
    End Function

    Protected Overridable Sub unalloc(ByRef inst As T)
        inst = Nothing
    End Sub

    Public Overridable Sub close()
        For i As Int64 = 0 To size() - 1
            If Not at(i) Is Nothing Then
                unalloc(at(i))
            End If
        Next
        _lock = Nothing
    End Sub
End Class

Public Class pool(Of t)
    Inherits pool(Of t, _true, _false)

    Public Sub New(Optional ByVal buffsize As Int64 = defaultBuffCount)
        MyBase.New(buffsize)
    End Sub
End Class

Public Class pool(Of t, _THREADSAFE As _boolean, _RNDSELECT As _boolean)
    Inherits poolbase(Of t, _THREADSAFE, _RNDSELECT, _false)

    Public Const defaultBuffCount As Int64 = 1024
    Private _pool() As t
    Private _free() As Boolean

    Public Sub New(Optional ByVal buffsize As Int64 = defaultBuffCount)
        MyBase.New()
        If buffsize < 0 Then
            buffsize = defaultBuffCount
        End If

        ReDim _pool(buffsize - 1)
        ReDim _free(buffsize - 1)
        memset(_free, 0, buffsize, True)
    End Sub

    Protected Overrides Property at(ByVal index As Int64) As t
        Get
            Return _pool(index)
        End Get
        Set(ByVal value As t)
            _pool(index) = value
        End Set
    End Property

    Protected Overrides Property free(ByVal index As Int64) As Boolean
        Get
            Return _free(index)
        End Get
        Set(ByVal value As Boolean)
            _free(index) = value
        End Set
    End Property

    Protected Overrides Function size() As Int64
        Return _pool.Length()
    End Function

    Public Overrides Sub close()
        MyBase.close()
        [erase](_pool)
        [erase](_free)
    End Sub
End Class
